home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 061-070 / amok66 / sorting / sorting.mod < prev    next >
Text File  |  1993-11-04  |  3KB  |  103 lines
  1. (******************************************************************************
  2.  
  3.     :Program.    Sorting.mod
  4.     :Contents.   procedure for sorting
  5.     :Revision.   4
  6.     :Date.       15.11.91 --- 15:57 --- [UHU]
  7.     :Author.     Markus Uhlendahl
  8.     :Address.    Vorm Burgtor 16, D-4408 Dülmen
  9.     :Phone.      02594/81540
  10.     :Language.   Modula-2
  11.     :Translator. M2Amiga 4.0d
  12.     :Copyright.  Public Domain
  13.     :History.    15.11.91 --- 1.0 --- first release
  14.  
  15. ******************************************************************************)
  16. IMPLEMENTATION MODULE Sorting;
  17.  
  18.  
  19. PROCEDURE InternalLower (a,b       : LONGINT;
  20.                          Lower     : Comparison;
  21.                          ascending : BOOLEAN) : BOOLEAN;
  22. (*
  23.  * FUNCTION     compare two elements
  24.  *              If ascending is TRUE it returns element a lower than element b
  25.  *              else it returns element a greater than element b
  26.  * INPUTS       a = index of an element in the array
  27.  *              b = index of an element in the array
  28.  *              Lower = PROCEDURE which compares two elements of an array
  29.  *                      returns TRUE if the first element of the comparison
  30.  *                      is really lower (a<b) than the second element
  31.  *              ascending = if ascending is TRUE the result will be a<b else
  32.  *                          the result will be b<a
  33.  * RESULTS      if ascending than a<b else b<a
  34.  *
  35.  *)
  36.  
  37. BEGIN
  38.   IF ascending THEN
  39.     RETURN (Lower(a,b));
  40.   ELSE
  41.     RETURN (Lower(b,a));
  42.   END;
  43. END InternalLower;
  44.  
  45.  
  46. PROCEDURE QuickSort (first,last : LONGINT;
  47.                      Lower      : Comparison;
  48.                      Swap       : SwapProcedure;
  49.                      ascending  : BOOLEAN);
  50. (*
  51.  * FUNCTION     sort an array
  52.  *              This implementation of the quicksort-algorythm is very
  53.  *              flexible. It sorts arrays of every type and the user can
  54.  *              choose if the array is sorted ascending or not. To make this
  55.  *              possible the user has to write two procedures. One that
  56.  *              compares two elements of the array and one that swaps two
  57.  *              elements.
  58.  * INPUTS       first = first index of the array
  59.  *              last = last index of the array
  60.  *              Lower = PROCEDURE which compares two elements of the array
  61.  *                      returns TRUE if the first element of the comparison
  62.  *                      is really lower (a<b) than the second element
  63.  *              Swap = PROCEDURE which swaps two elements of the array
  64.  *              ascending = if ascending is TRUE the first element of the
  65.  *                          array will be the smallest and the last element
  66.  *                          the greatest
  67.  *                          if ascending is FALSE it will be vice versa
  68.  * BUGS         none known
  69.  * AUTHOR       Markus Uhlendahl
  70.  *
  71.  *)
  72.  
  73. VAR
  74.   i,j,x : LONGINT;
  75.  
  76. BEGIN
  77.   i:=first;
  78.   j:=last;
  79.   x:=(first+last) DIV 2;
  80.   REPEAT
  81.     WHILE InternalLower(i,x,Lower,ascending) DO
  82.       INC (i);
  83.     END;
  84.     WHILE InternalLower(x,j,Lower,ascending) DO
  85.       DEC (j);
  86.     END;
  87.     IF i<=j THEN
  88.       Swap (i,j);
  89.       INC (i);
  90.       DEC (j);
  91.     END;
  92.   UNTIL i>j;
  93.   IF first<j THEN
  94.     QuickSort (first,j,Lower,Swap,ascending);
  95.   END;
  96.   IF i<last THEN
  97.     QuickSort (i,last,Lower,Swap,ascending);
  98.   END;
  99. END QuickSort;
  100.  
  101.  
  102. END Sorting.
  103.